Shareware Grab Bag/Shareware Grab Bag.iso/003/chrchpr2.arc/CSEUPDAT.CMD

Text File | 1979-12-31 | 9.0 KB | 312 lines

* Program CSEUPDAT - Allows an operator to change/add to the MEMBERS file
STORE DATE() TO INDATE
Set deleted on
Select secondary
Store 'ROOM=' to infield
 ? '  ',ename,'-  LODGING names               '+curdate
 Find &INFIELD
 Store ' ' to romvalid
 If #=0
 ? 'No Lodgings found. '
 else
 Set raw on
 Do while spact=infield
  Store romvalid+$(spact,5,4) to romvalid
  Store $(spact,1,9) to innf
  ? '[',$(spact,6,3),']  ',$(spact,9,30)
  Do while spact=innf.or.$(spact,9,1)='.'
    SKIP
  enddo
 enddo
 Store 'Y' to xsel
 ? '   VALID LODGING CODES: ',romvalid
 ?
 endif
Store 'TRAN=' to infield
? '  ',ename,' TRANSPORTATION names        '+curdate
 Find &INFIELD
 Store ' ' to tranvalid
 If #=0
 ? 'No Transportation codes found. '
 else
 Set raw on
 Do while spact=infield.and. .not. EOF
  Store tranvalid+$(spact,5,6) to tranvalid
  Store $(spact,1,11) to innf
  ? '[',$(spact,6,5),']  ',$(spact,11,28)
  Do while (spact=innf.or.$(spact,11,1)='.').and. .not.EOF
    SKIP
  enddo
 enddo
 Store 'Y' to xsel
 ? '   VALID TRANSPORTATION CODES: ',tranvalid
 endif
Accept 'Press <retn> to continue ' to xx
Select primary
Store F to ADDEDREC
Store T to CONTINU
STORE '       ' TO ESELECT
DO WHILE CONTINU
  ERASE
  @ 1,1 say ename
  @ 1,63 say curdate
  @ 2,1 say 'DATA DISK = '+D
  @ 4,20 say 'Special Event Attender Update Process        1-/CSEUPDAT/'
  @ 7,12 say 'M)  Merge new names from MEMBERS marked "SPECIAL"'
 @ 8,12 say 'A)  Add a new Attender                                 /CSEADD  /'
  @ 9,12 say "C)  Change an Attender's information"
  @ 10,12 say "D)  Delete an Attender"
  @ 11,12 say 'Q)  QUIT'
 ?
Accept '                 Enter selection ' to ESEL
?
  Store T to INVALCC
  Do while INVALCC
    Store F to invalcc
    Do CASE
    CASE !(ESEL) = 'A'
      DO CSEADD.CMD
      Store T to ADDEDREC
    CASE !(esel)='M'
? 'This routine uses the MEMBERS file which must be present on the data disk.'
      Accept 'OK? ' to xx
      Store d+':MEMBERS' to NFILE
      If !(xx)='Y'
      If .not. file(NFILE)
  Accept 'The MEMBERS file is not present on the data disk. Press <retn>' to XX
      else
       ? '    Now reading the MEMBERS file for members marked "Special"'
       Select secondary
       Use &NFILE
       Store 0 to reccc
       Do while .not. EOF
        Store 0 to rec
        Store 0 to recc
        Store '   ' to recnumbs
        Do while rec<60 .and..not. EOF
          If $(membstatus,9,1)='x'
            Store rec+1 to rec
            Select primary
            Append blank
            Replace last:name with S.last:name
            Replace first:name with S.first:name
            Replace address with S.address
            Replace city:state with S.city:state
            Replace zip with S.zip
            Replace ss:sc:memb with S.ss:sc:memb
            Replace membstatus with S.membstatus
            Replace comments with S.comments
            Replace birthdate with S.birthdate
            Replace home:phone with S.home:phone
            Replace dates with s.dates
            Replace amount with ECOST
            Store reccc+1 to reccc
            Store recnumbs+str(#,4) to recnumbs
            Select secondary
         ? str(#,4),' ',$(last:name,1,12),$(first:name,1,11),home:phone,address
         ?? membstatus
            Replace membstatus with $(membstatus,1,8)+'y'
          endif
          SKIP
         enddo
          If rec>0
            Store str(#,4) to lrec
            Use EDIRFILE index EDIRFILE
            Store recc+rec to recc
            Store rec to recx
? recc,' RECORDS TRANSFERED FROM MEMBERS. Now processing them (the last 60).'
            Store 0 to rec
            Do while rec<recx
              Store rec+1 to rec
              Select primary
              Store $(recnumbs,rec*4,4) to reci
              GOTO &reci
  ? 'Now editing record for: ',last:name,first:name
  ?
  ?
  ?
    @ 21,0 say 'Enter SESSIONS   ' get SESSIONS
    @ 22,0 say 'Enter EQUIPMENT  ' get EQUIPMENT
    READ
    Set intensity off
 ?
 If romvalid<>' '
 Store F to goodlodg
 Do while .not. goodlodg
 Do while .not. goodlodg
  ? '    VALID LODGINGS: ',romvalid
  ? 'Lodging code format: LLL RRRR  - LLL=Building,  RRRR=Room/Bed'
  Accept '   Select a Lodging code (3,4 characters) ' to inlodg
  Store inlodg+'        ' to inlodg
  Store $(inlodg,1,3) to inlodgx
  Store $(inlodg,5,5) to inlodgy
  ? 'BUILDING: ',inlodgx,'      ROOM/BED: ',inlodgy
  Store '='+inlodgx to innlodge
  Store T to goodlodg
  If !(inlodg)='Q     '.or.inlodg='         '
    Store '         ' to inlodg
    Store '________' to xx
  else
   If @(innlodge,romvalid)=0
    ? 'Lodging code is not found. Enter another.'
    Store F to goodlodg
   endif
  endif
 enddo
 If inlodg<>'         '
  Select secondary
  Store 'ROOM='+$(inlodg,1,9) to xx
  Find &xx
  If #=0
    Append blank
    Replace spact with xx+$(P.last:name,1,11)+' '+$(P.first:name,1,10)
    Select primary
    Replace room with inlodg
  else
    If $(spact,15,22)='                      '
      Replace spact with xx+$(P.last:name,1,11)+' '+$(P.first:name,1,10)
      Select primary
      Replace room with inlodg
    else
    ? 'This Lodging is already assigned. Enter another.'
    Store F to goodlodg
    endif
  endif
 endif
 enddo
 ? 'Now assigned: ',xx,'  ',P.last:name,P.first:name
 ?
 endif
 If tranvalid<>' '
 Store F to goodlodg
 Do while .not. goodlodg
  ? 'VALID TRANSPORTATION CODES: ',tranvalid
  Accept '      Select a Transportation code (5 characters) ' to inlodg
  STORE INLODG+'    ' to inlodg
  Store $(inlodg,1,5) to inlodg
  Store '='+inlodg to innlodge
  Store T to goodlodg
  If !(inlodg)='Q    '.or.inlodg='     '
    Store '     ' to inlodg
  else
   If @(innlodge,tranvalid)=0
    ? 'Transportation code is not found. Enter another '
    Store F to goodlodg
   endif
  endif
 enddo
 If !(inlodg)<>'     '
   Select primary
   Store $(last:name,1,11)+' '+$(first:name,1,10) to nfind
   Replace transpor with inlodg
   Select secondary
   Append blank
   Replace spact with 'TRAN='+inlodg+' '+nfind
   ? 'Now assigned:  ',spact
 else
   ? 'Now assigned:  TRAN=_____'
 endif
 ?
 endif
            enddo
            Use &NFILE
            GOTO &lrec
          endif
       enddo
       ? RECCC,' TOTAL RECORDS APPENDED TO MEMBERSE.'
       ?
       Accept 'File update is complete. Press <return> to continue ' to xx
      endif
      endif
    CASE !(ESEL) = 'C' .or. !(ESEL) = 'D'
      Store F to CSEEDIT
      If len(ESEL) > 1
        Select primary
        Store len(esel) to n
        Store val($(esel,2,n-1)) to nn
        If NN > 0
         Store str(NN,5) to xx
         GOTO &XX
         If !(esel)='D'
           ? 'The following name is to be deleted: ',last:name,first:name
           Accept 'OK? ' to xx
           If !(xx)='Y'
             ? 'DELETED -',last:name,first:name
             DELETE
           else
             ? 'No delete is made.'
           endif
         else
           Store T to CSEEDIT
         endif
        else
          Accept 'Invalid record number. Press <retn> ' to xx
        endif
      else
        Store '   Editing' to deled
        Do CSECHECK.CMD
        If found
          Store T to CSEEDIT
        endif
      endif
      If CSEEDIT
         Store 0.00 to pd1
         Store 0.00 to pd2
         Store pd1+val($(paid1,1,9)) to pd1
         Store pd2+val($(paid2,1,9)) to pd2
         ERASE
  Set intensity on
  Store STR(#,5) to RECSTR
  @ 2,10 say 'CSEVENT   -   Editing record number '+RECSTR
  @ 5,1  say 'LAST NAME  '  GET LAST:NAME
  @ 5,40 SAY 'FIRST NAME '  GET FIRST:NAME
  @ 6,40 say 'HOME PHONE '  get home:phone
  @ 6,1  SAY 'ADDRESS    '  GET ADDRESS
  @ 7,1  SAY 'CITY,STATE '  GET CITY:STATE
  @ 7,40 SAY 'ZIP CODE   '  GET ZIP
  @  8,1  SAY 'BIRTHDATE  ' GET BIRTHDATE PICTURE 'XX/XX/XX-XXX'
  @  8,40 SAY 'MEMBSTATUS ' GET MEMBSTATUS
  @  9,1  SAY 'SS/SC MEMB ' GET SS:SC:MEMB
  @  9,40 SAY 'COMMENTS   ' get COMMENTS
  @ 11,1 say 'LODGING  = '+ROOM
  @ 12,1 say 'TRANSPORTATION  = '+transpor
  @ 10,40 say 'AMOUNT   $' get amount
  @ 11,40 say 'PAID-1   $' get pd1
  @ 11,66 say $(paid1,11,8)
  @ 12,40 say 'PAID-2   $' get pd2
  @ 12,66 say $(paid2,11,8)
  @ 14,1 say 'EQUIPMENT' get EQUIPMENT
  @ 15,1 say 'SESSIONS ' GET SESSIONS
  @ 17,10 say 'Press <ctrl-W> when editing is complete.'
  ?
  READ
  If val($(paid1,1,9))<>pd1
    Replace paid1 with str(pd1,9,2)+' '+indate
  endif
  If val($(paid2,1,9))<>pd2
    Replace paid2 with str(pd2,9,2)+' '+indate
  endif
  Set intensity off
      endif
      Store F to invalcc
    CASE !(ESEL) = 'Q'
      Store F to CONTINU
    OTHERWISE
      Accept 'Illegal entry.  Please enter again ' to ESEL
      Store T to invalcc
    ENDCASE
    enddo
 ENDDO
RETURN
          N
          HERWISE
      Accept 'Illegal entry.  Please enter again ' to ESEL
      Store T to invalcc
    ENDCASE
    enddo
 ENDDO
RETURN
          DO
RETURN
          umber '+RECSTR
  @ 5,1